SPACE 2/SPACE - Library 2 - Volume 1.iso/magazi~1/371/picpuzzl.pas

Pascal/Delphi Source File | 1989-03-10 | 31.1 KB | 882 lines

{******************************************************************}
{*  Picture Puzzle is a game that takes a picture of format .NEO, *}
{*  .PI1, .PI2, or .PI3 and let's you break that picture up into  *}
{*  several pieces.  Those pieces are then shuffled and you must  *}
{*  rearrange those pieces into the picture again.  This program  *}
{*  was written so the author could create routines to read in    *}
{*  picture files.  It was also written as an introduction to the *}
{*  bit blit operations available on the Atari ST.                *}
{*                                                                *}
{*             COPYRIGHT 1988 BY ST-LOG MAGAZINE                  *}
{******************************************************************}

PROGRAM Picture_Puzzle ;

  CONST
    {$I GEMCONST.PAS}
    right_arrow = $4D00 ;
    left_arrow = $4B00 ;
    up_arrow = $4800 ;
    down_arrow = $5000 ;
    PF1 = $3B00 ;
    Low_Resolution = 1 ;
    Medium_Resolution = 2 ;
    High_Resolution = 3 ;

  TYPE
    {$I gemtype.pas}
    palet = ARRAY [0..15] OF Integer ;
    PI_Record = Record
      res : Integer ;
      palette : palet ;
      image : Array [1..16000] OF Integer ;
    END ;
    NEO_Record = Record
      res : Long_Integer ;
      palette : palet ;
      miscellany : Array [0..45] OF Integer ;
      image : Array [1..16000] OF Integer ;
    END ;
    scrn_memory     = ARRAY [1..16000] OF Integer;
    mfdb_fields     =
       (addr1,addr2,wid_pix,ht_pix,wid_wds,flag,num_planes,r1,r2,r3);
    mfdb            = ARRAY [mfdb_fields] OF Integer;

  VAR
    screen,backup,image_area : MFDB;
    screen_buffer : scrn_memory;

    PI_file : FILE OF PI_Record ;
    PI_image: PI_Record ;

    NEO_file : FILE OF NEO_Record ;
    NEO_image: NEO_Record ;

    palette, save_palette : palet ;  { working palette }

    Xmax, Ymax, Wmax, Hmax, resolution, dummy, key, event,
    palette_max, vertical, horizontal, rect_width, rect_height,
    left_margin, top_margin, chosen: Integer ;

    msg: Message_Buffer ;
    default_path: Path_Name ;
    block_position: Array [0..21, 0..21] OF Integer ;
    puzzle_solved: Boolean ;
    res_string : Array [0..3] OF Str255 ;
    alert_str: Str255 ;

  {$I gemsubs.pas}

{******************************************************************}
{*  These two routines are linked with the program.  They were    *}
{*  taken from O.S.S.'s bulletin board and allow me to use bit    *}
{*  blit operations.                                              *}
{******************************************************************}

PROCEDURE init_form(var form: MFDB ; var addr : scrn_memory ;
                    resolution : Integer) ;
  EXTERNAL ;

PROCEDURE copy_rect(var s,d : MFDB ;
                  from_x, from_y, to_x, to_y, wid, ht: Integer) ;
  EXTERNAL ;

{******************************************************************}
{*  I call this routine in order to retrieve the current color    *}
{*  register settings.  This is in order to return the original   *}
{*  colors when exiting the program.                              *}
{******************************************************************}

FUNCTION st_clr( register, color: integer): integer ;
   Xbios( 7 );

{******************************************************************}
{*  These are the random number routines taken from the O.S.S.    *}
{*  bulletin board.  I call these routines to choose random rec-  *}
{*  tangles when I shuffle up the picture.                        *}
{******************************************************************}

Function XB_Rnd : Long_Integer;  { get xbios random 24-bit number }
   Xbios( 17 );

Function Rnd : Real;

   Begin
      Rnd := XB_Rnd / 16777216.0;
   End;

Function Random( Low, Hi : Integer ) : Integer;

   Begin
      Random := Low + Trunc( Rnd * ( Hi - Low +1 ) );
   End;

{******************************************************************}
{*  This routine is used to determine the mouse x/y position.     *}
{*  I previously used the Get_Event function but this was only    *}
{*  partially effective as it did not recognize a mouse event at  *}
{*  the top of the screen in the menu area.                       *}
{******************************************************************}

PROCEDURE sample_mouse(VAR status, x_posit, y_posit: integer) ;

    TYPE
      Ctrl_Parms      = ARRAY [ 0..11 ] OF integer ;
      Int_In_Parms    = ARRAY [ 0..15 ] OF integer ;
      Int_Out_Parms   = ARRAY [ 0..45 ] OF integer ;
      Pts_In_Parms    = ARRAY [ 0..11 ] OF integer ;
      Pts_Out_Parms   = ARRAY [ 0..11 ] OF integer ;

    VAR
      control : Ctrl_Parms ;
      int_in  : Int_In_Parms ;
      int_out : Int_Out_Parms ;
      pts_in  : Pts_In_Parms ;
      pts_out : Pts_Out_Parms ;

    PROCEDURE VDI_Call( cmd, sub_cmd : integer ; nints, npts : integer ;
                VAR ctrl : Ctrl_Parms ;
                VAR int_in : Int_In_Parms ; VAR int_out : Int_Out_Parms ;
                VAR pts_in : Pts_In_Parms ; VAR pts_out : Pts_Out_Parms ;
                translate : boolean ) ;
      EXTERNAL ;

begin
   VDI_Call(124,0,0,0,control,int_in,int_out,pts_in,pts_out,false);
   status := int_out[0] ;
   x_posit := pts_out[0] ;
   y_posit := pts_out[1] ;
end;

{******************************************************************}
{*  I call this routine to set the color palette to the colors    *}
{*  read in from the picture files.                               *}
{******************************************************************}

PROCEDURE Set_Palette(pal: palet) ;

VAR x: Integer ;

  BEGIN
    FOR x := 0 TO palette_max DO
      BEGIN
        IF x = palette_max THEN
          palette[1] := pal[x]
        ELSE
          CASE x OF
            0,4,12 : palette[x] := pal[x] ;
            1,2,7,8,9,10 : palette[x+1] := pal[x] ;
            3,11 : palette[x+3] := pal[x] ;
            5,13 : palette[x+2] := pal[x] ;
            6,14 : palette[x-1] := pal[x] ;
          END ;
      END ;
    {set colors here}
    FOR x := 0 TO 15 DO
      Set_Color( x, Shr(Shl(palette[x],5),13)*124+62,
                    Shr(Shl(palette[x],9),13)*124+62,
                    Shr(Shl(palette[x],13),13)*124+62) ;
  END ;

{******************************************************************}
{*  This procedure is called to erase the screen.                 *}
{******************************************************************}

PROCEDURE erase_screen ;

  BEGIN
    hide_mouse ;
    clear_screen ;
    show_mouse ;
  END ;

{******************************************************************}
{*  This function returns the resolution in which the program is  *}
{*  currently being executed.                                     *}
{******************************************************************}

FUNCTION Get_Res: Integer ;

  BEGIN
    Work_Rect( 0, Xmax, Ymax, Wmax, Hmax ) ;
    IF Wmax=320 THEN
        Get_Res := Low_Resolution
    ELSE
      IF Hmax>200 THEN
        Get_Res := High_Resolution
      ELSE
        Get_Res := Medium_Resolution ;
  END ;

{******************************************************************}
{*  This is the main loop.  Within it the picture file is chosen, *}
{*  and then manipulated by the user.                             *}
{******************************************************************}

PROCEDURE Main_Loop ;

VAR file_name: Path_Name ;
    file_to_input, valid_ext: Boolean ;
    x, result, pi1_spot, pi2_spot, pi3_spot, neo_spot: Integer ;

{******************************************************************}
{*  This routine will always display the picture image in it's    *}
{*  completed form.                                               *}
{******************************************************************}

PROCEDURE Display_Picture ;

VAR x: Integer ;

  BEGIN
    hide_mouse ;
    copy_rect(image_area,screen,0,0,0,0,Wmax,Hmax) ;
    show_mouse ;
  END ;

{******************************************************************}
{*  This routine allows the user to break up the picture in any   *}
{*  combination of rectangles.                                    *}
{******************************************************************}

PROCEDURE get_squares ;

VAR x, y, vert_lines, horz_lines,
    offset_1, offset_2, work_1, work_2: Integer ;

{******************************************************************}
{*  This routine is called if the user hits the PF1 key while     *}
{*  breaking up the picture into rectangles.  It allows the user  *}
{*  to select the color of the lines which seperate each rectan-  *}
{*  gle.  Only those colors in the current palette may be chosen. *}
{******************************************************************}

PROCEDURE change_line_color ;

VAR color_dialog: Dialog_Ptr ;
    pattern, x, ok_button: Integer ;
    color_item: palet ;

  BEGIN
    color_dialog := New_Dialog( 18, 0, 0, 27, 12 ) ;
    ok_button := Add_DItem(color_dialog, G_Button, Selectable|Exit_Btn,
                             11, 8, 5, 2, 1, 0) ;
    FOR x := 0 TO 15 DO
      BEGIN
        IF x>palette_max THEN
          BEGIN
            pattern := 1 ;
            color_item[x] := Add_DItem(color_dialog, G_Box, None,
                             (x*3)+2-(8*(x DIV 8)*3), (x DIV 8)*3+2,
                             2, 2, -1, x|(pattern*16)|4096) ;
          END
        ELSE
          BEGIN
            pattern := 7 ;
            color_item[x] := Add_DItem(color_dialog, G_Box,
                         Selectable|Exit_Btn, (x*3)+2-(8*(x DIV 8)*3),
                         (x DIV 8)*3+2, 2, 2, -1,
                         x|(pattern*16)|4096|128) ;
          END ;
      END ;
    FOR x := 0 TO 15 DO
      IF x = chosen THEN
        obj_setstate(color_dialog, color_item[x], checked, false) ;
    set_dtext(color_dialog, ok_button, 'OK', system_font, TE_Center) ;
    center_dialog(color_dialog) ;
    dummy := do_dialog(color_dialog, 0) ;
    While dummy<>ok_button DO
      BEGIN
        FOR x := 0 TO 15 DO
          IF dummy = color_item[x] THEN
            BEGIN
              chosen := x ;
              IF Obj_State(color_dialog, color_item[x])&checked=0 THEN
                BEGIN
                  obj_setstate(color_dialog, color_item[x], normal, true) ;
                  obj_setstate(color_dialog, color_item[x], checked, true) ;
                END
              ELSE
                BEGIN
                  obj_setstate(color_dialog, color_item[x], checked, true) ;
                  obj_setstate(color_dialog, color_item[x], normal, true) ;
                END ;
            END
          ELSE
            IF Obj_State(color_dialog, color_item[x])&checked<>0 THEN
              BEGIN
                obj_setstate(color_dialog, color_item[x], selected, true) ;
                obj_setstate(color_dialog, color_item[x], checked, true) ;
                obj_setstate(color_dialog, color_item[x], normal, true) ;
              END ;
        dummy := redo_dialog(color_dialog, 0) ;
      END ;
    Line_Color(chosen) ;
    end_dialog(color_dialog) ;
    delete_dialog(color_dialog) ;
  END ;

{******************************************************************}
{*  This is the beginning of routine get_squares.  The user uses  *}
{*  the arrow keys and the PF1 key to break up the picture.  The  *}
{*  user may hit the escape key at any time whereupon the program *}
{*  will return to the file selection menu.                       *}
{******************************************************************}

  BEGIN
    display_picture ;
    horizontal := 1 ;
    vertical := 1 ;
    line_style(1) ;
    draw_mode(1) ;
    event := Get_Event( E_Keyboard, 0, 0, 0, 0, False,
                        0, 0, 0, 0, False, 0, 0, 0, 0, msg,
                        key, dummy, dummy, dummy, dummy, dummy ) ;
    WHILE (key=right_arrow) OR (key=left_arrow) OR
          (key=up_arrow)    OR (key=down_arrow) OR (key=PF1) DO
      BEGIN
        CASE key OF
          right_arrow: IF horizontal<22 THEN
                         horizontal := horizontal + 1 ;
          left_arrow:  IF horizontal > 1 THEN
                         horizontal := horizontal - 1 ;
          up_arrow:    IF vertical<22 THEN
                         vertical := vertical + 1 ;
          down_arrow:  IF vertical > 1 THEN
                         vertical := vertical - 1 ;
        END ;

        IF key=PF1 THEN
          change_line_color ;

        display_picture ;

        vert_lines := 0 ;
        horz_lines := 0 ;
        left_margin := 0 ;
        top_margin := 0 ;
        rect_width := Wmax ;
        rect_height := Hmax ;

        hide_mouse ;
        IF vertical>1 THEN
          BEGIN
            REPEAT
              vert_lines := vertical-1+2 ;
              rect_width := (Wmax-vert_lines) DIV vertical ;
              left_margin := (((Wmax-vert_lines) MOD vertical) DIV 2) + 1 ;
              IF rect_width=0 THEN
                vertical := vertical-1 ;
            UNTIL rect_width>0 ;
          END ;

        IF horizontal>1 THEN
          BEGIN
            REPEAT
              horz_lines := horizontal-1+2 ;
              rect_height := (Hmax-horz_lines) DIV horizontal ;
              top_margin := (((Hmax-horz_lines) MOD horizontal) DIV 2) + 1 ;
              IF rect_height=0 THEN
                horizontal := horizontal-1 ;
            UNTIL rect_height>0 ;
          END ;

          IF left_margin>0 THEN
            offset_1 := left_margin-1
          ELSE
            offset_1 := left_margin ;

          IF top_margin>0 THEN
            offset_2 := top_margin-1
          ELSE
            offset_2 := top_margin ;

          IF vertical>1 THEN
            BEGIN
              work_2 := (horizontal*rect_height)+horz_lines+offset_2-1 ;
              FOR x := 1 TO vert_lines DO
                BEGIN
                  work_1 := (x-1)*(rect_width+1)+offset_1 ;
                  Line(work_1, offset_2 , work_1, work_2 ) ;
                END ;
            END ;

          IF horizontal>1 THEN
            BEGIN
              work_2 := (vertical*rect_width)+vert_lines+offset_1-1 ;
              FOR x := 1 TO horz_lines DO
                BEGIN
                  work_1 := (x-1)*(rect_height+1)+offset_2 ;
                  Line(offset_1, work_1, work_2, work_1 ) ;
                END ;
            END ;

        show_mouse ;

        event := Get_Event( E_Keyboard, 0, 0, 0, 0, False,
                            0, 0, 0, 0, False, 0, 0, 0, 0, msg,
                            key, dummy, dummy, dummy, dummy, dummy ) ;
      END ;
    FOR x := 0 TO horizontal-1 DO
      FOR y := 0 TO vertical-1 DO
        block_position[x,y] := x*vertical+y ;
  END ;

{******************************************************************}
{*  This routine is called after the user has broken up the pic-  *}
{*  ture into rectangles.  This routine randomly shuffles up      *}
{*  those rectangles.                                             *}
{******************************************************************}

PROCEDURE shuffle_picture ;

VAR x, x1, x2, y1, y2, hold: Integer ;

  BEGIN
    hide_mouse ;
    FOR x := 1 TO horizontal*vertical*2 DO
      BEGIN
        x1 := Random(0,horizontal-1) ;
        x2 := Random(0,horizontal-1) ;
        y1 := Random(0,vertical-1) ;
        y2 := Random(0,vertical-1) ;

        hold := block_position[x1,y1] ;
        block_position[x1,y1] := block_position[x2,y2] ;
        block_position[x2,y2] := hold ;

        copy_rect(backup,screen,rect_width*y1+y1+left_margin,
                                rect_height*x1+x1+top_margin,
                                rect_width*y2+y2+left_margin,
                                rect_height*x2+x2+top_margin,
                                rect_width,rect_height) ;
        copy_rect(backup,screen,rect_width*y2+y2+left_margin,
                                rect_height*x2+x2+top_margin,
                                rect_width*y1+y1+left_margin,
                                rect_height*x1+x1+top_margin,
                                rect_width,rect_height) ;
        copy_rect(screen,backup,0,0,0,0,Wmax,Hmax) ;
      END ;
    show_mouse ;
  END ;

{******************************************************************}
{*  This routine is called after the rectangles are shuffled.     *}
{*  The user must now rearrange the puzzle by clicking the left   *}
{*  button on any two (2) rectangles which will interchange.  If  *}
{*  the user pushes the right mouse button and holds it down the  *}
{*  picture in it's original stage will be displayed.             *}
{******************************************************************}

PROCEDURE exchange_squares ;

VAR mx1, my1, mx2, my2, x1, y1, x2, y2,
    x, y, hold, left_button, right_button: Integer ;

{******************************************************************}
{*  This routine checks to see if the right mouse button has been *}
{*  depressed.  If it has it then displays the original picture   *}
{*  until the mouse button is released.                           *}
{******************************************************************}

PROCEDURE check_right ;

  BEGIN
    right_button := Get_Event( E_Keyboard|E_Button|E_Timer, 2, 2, 1, 0,
                               False, 0, 0, 0, 0, False, 0, 0, 0, 0, msg,
                               key, dummy, dummy, dummy, dummy, dummy ) ;
    IF (right_button&E_Button)>0 THEN
      BEGIN
        hide_mouse ;
        copy_rect(screen,backup,0,0,0,0,Wmax,Hmax) ;
        show_mouse ;
        display_picture ;
        right_button := Get_Event( E_Button, 2, 0, 1, 0, False, 0, 0, 0, 0,
                                   False, 0, 0, 0, 0, msg, key, dummy, dummy,
                                   dummy, dummy, dummy ) ;
        hide_mouse ;
        copy_rect(backup,screen,0,0,0,0,Wmax,Hmax) ;
        show_mouse ;
      END ;
  END ;

{******************************************************************}
{*  This is the start of procedure exchange_squares.              *}
{******************************************************************}

  BEGIN
    puzzle_solved := True ;
    FOR x := 0 TO horizontal-1 DO
      FOR y := 0 TO vertical-1 DO
        IF block_position[x,y]<>(x*vertical+y) THEN
          puzzle_solved := False ;
    WHILE (NOT puzzle_solved) AND (key<>$011B) DO
      BEGIN
        left_button := 0 ;
        WHILE (left_button<>1) AND (key<>$011B) DO
          BEGIN
            sample_mouse(left_button, mx1, my1) ;
            IF left_button=1 THEN
              BEGIN
                y1 := (mx1-left_margin) DIV (rect_width+1) ;
                x1 := (my1-top_margin) DIV (rect_height+1) ;
                IF (y1>=vertical) OR (x1>=horizontal) OR (y1<0) OR (x1<0) THEN
                  left_button := 0 ;
              END
            ELSE
              check_right ;
          END ;
        IF key<>$011B THEN
          BEGIN
            {wait for left button up}
            FOR x := 1 TO 30000 DO ;
            left_button := 0 ;
            WHILE (left_button<>1) AND (key<>$011B) DO
              BEGIN
                sample_mouse(left_button, mx2, my2) ;
                IF left_button=1 THEN
                  BEGIN
                    y2 := (mx2-left_margin) DIV (rect_width+1) ;
                    x2 := (my2-top_margin) DIV (rect_height+1) ;
                    IF (y2>=vertical) OR (x2>=horizontal) OR
                       (y2<0) OR (x2<0) THEN
                      left_button := 0 ;
                  END
                ELSE
                  check_right ;
              END ;
            IF key<>$011B THEN
              BEGIN
                {wait for left button up}
                FOR x := 1 TO 30000 DO ;
                hide_mouse ;
                y1 := (mx1-left_margin) DIV (rect_width+1) ;
                y2 := (mx2-left_margin) DIV (rect_width+1) ;
                x1 := (my1-top_margin) DIV (rect_height+1) ;
                x2 := (my2-top_margin) DIV (rect_height+1) ;
                copy_rect(backup,screen,rect_width*y1+y1+left_margin,
                                        rect_height*x1+x1+top_margin,
                                        rect_width*y2+y2+left_margin,
                                        rect_height*x2+x2+top_margin,
                                        rect_width,rect_height) ;
                copy_rect(backup,screen,rect_width*y2+y2+left_margin,
                                        rect_height*x2+x2+top_margin,
                                        rect_width*y1+y1+left_margin,
                                        rect_height*x1+x1+top_margin,
                                        rect_width,rect_height) ;
                copy_rect(screen,backup,0,0,0,0,Wmax,Hmax) ;
                show_mouse ;

                hold := block_position[x1,y1] ;
                block_position[x1,y1] := block_position[x2,y2] ;
                block_position[x2,y2] := hold ;

                puzzle_solved := True ;
                FOR x := 0 TO horizontal-1 DO
                  FOR y := 0 TO vertical-1 DO
                    IF block_position[x,y]<>(x*vertical+y) THEN
                      puzzle_solved := False ;
              END ;
          END ;
      END ;
  END ;

{******************************************************************}
{*  This function checks the resolution passed to it with the     *}
{*  current resolution.  If they do not match an alert box is     *}
{*  displayed saying so and a -99 is returned to indicate that    *}
{*  the picture read in can not be displayed in the current res-  *}
{*  olution.                                                      *}
{******************************************************************}

FUNCTION Check_Res(image_res: integer): Integer ;

  BEGIN
    check_res := 0 ;
    IF (resolution-1)<>image_res THEN
      BEGIN
        alert_str := Concat('[3][',
                            res_string[image_res],
                            '|resolution to|load this file!]',
                            '[Cancel]') ;
        dummy := Do_Alert(alert_str,1) ;
        check_res := -99 ;
      END ;
  END ;

{******************************************************************}
{*  This function reads in a file with the extension of .NEO.     *}
{******************************************************************}

FUNCTION Get_NEO: Integer ;

VAR result, x : Integer ;

  BEGIN
    Reset( NEO_file, file_name ) ;
    NEO_image := NEO_file^ ;
    IO_Check(False) ;
    Get( NEO_file ) ;
    result := IO_Result ;
    Close( NEO_file ) ;
    IO_Check(True) ;
    IF result=0 THEN
      BEGIN
        result := Check_Res(INT(NEO_Image.res)) ;
        IF result=0 THEN
          BEGIN
            Set_Palette(NEO_image.palette) ;
            FOR x := 1 TO 16000 DO
              screen_buffer[x] := NEO_image.image[x] ;
            init_form(image_area,NEO_image.image,resolution) ;
          END ;
      END ;
    Get_NEO := result ;
  END ;

{******************************************************************}
{*  This function reads in a file with the extension of .PI*.     *}
{******************************************************************}

FUNCTION Get_PI: Integer ;

VAR result, x : Integer ;

  BEGIN
    Reset( PI_file, file_name ) ;
    PI_image := PI_file^ ;
    IO_Check(False) ;
    Get( PI_file ) ;
    result := IO_Result ;
    Close( PI_file ) ;
    IO_Check(True) ;
    IF result=0 THEN
      BEGIN
        result := Check_Res(PI_Image.res) ;
        IF result=0 THEN
          BEGIN
            Set_Palette(PI_image.palette) ;
            FOR x := 1 TO 16000 DO
              screen_buffer[x] := PI_image.image[x] ;
            init_form(image_area,PI_image.image,resolution) ;
          END ;
      END ;
    Get_PI := result ;
  END ;

{******************************************************************}
{*  This procedure is called at the start of the program.  It     *}
{*  displays the copyright information on Personal Pascal.        *}
{******************************************************************}

PROCEDURE copyright_dialog ;

VAR copy_dialog : Dialog_Ptr ;
    ACD: Array [0..6] OF Integer ;
    ACD_OK : Integer ;

  BEGIN
    copy_dialog := New_Dialog( 10,0,0,36,17) ;

    ACD[0] := Add_DItem( copy_dialog,G_String,None,7,2,0,1,0,0) ;
    ACD[1] := Add_DItem( copy_dialog,G_String,None,5,4,0,1,0,0) ;
    ACD[2] := Add_DItem( copy_dialog,G_String,None,2,5,0,1,0,0) ;
    ACD[3] := Add_DItem( copy_dialog,G_String,None,5,6,0,1,0,0) ;
    ACD[4] := Add_DItem( copy_dialog,G_String,None,2,8,0,1,0,0) ;
    ACD[5] := Add_DItem( copy_dialog,G_String,None,2,10,0,1,0,0) ;
    ACD[6] := Add_DItem( copy_dialog,G_String,None,14,11,0,1,0,0) ;
    ACD_OK := Add_DItem( copy_dialog,G_Button,Selectable|Exit_btn,
                            15,13,6,2,0,0) ;

    Set_Dtext( copy_dialog,ACD[0],'Picture Puzzle Program',
               System_Font,TE_left) ;
    Set_Dtext( copy_dialog,ACD[1],'Written in Personal Pascal',
               System_Font,TE_Left) ;
    Set_Dtext( copy_dialog,ACD[2],'Copyright (c) 1986, OSS and CCD.',
               System_Font,TE_Left) ;
    Set_Dtext( copy_dialog,ACD[3],'Used by Permission of OSS.',
               System_Font,TE_left) ;
    Set_Dtext( copy_dialog,ACD[4], '    Author: Guy Davis',
               System_Font,TE_Left) ;
    Set_Dtext( copy_dialog,ACD[5], 'User Group: San Diego Atari',
               System_Font,TE_Left) ;
    Set_Dtext( copy_dialog,ACD[6], 'Computer Enthusiasts',
               System_Font,TE_Left) ;
    Set_Dtext( copy_dialog,ACD_OK,' OK ',
               System_Font,TE_Center) ;

    center_dialog(copy_dialog) ;
    dummy := do_dialog(copy_dialog, 0) ;
  END ;

{******************************************************************}
{*  This procedure checks the extension of the file selected.     *}
{*  This extension can only be .PI1, .PI2, .PI3, .NEO.  If  none  *}
{*  of these extensions are present then an alert box is shown    *}
{*  and the user is then asked to read in another file.           *}
{******************************************************************}

FUNCTION valid_extension(file_name: String): Boolean ;

  BEGIN
    pi1_spot := Pos( '.PI1', file_name) ;
    pi2_spot := Pos( '.PI2', file_name) ;
    pi3_spot := Pos( '.PI3', file_name) ;
    neo_spot := Pos( '.NEO', file_name) ;
    IF (pi1_spot|pi2_spot|pi3_spot|neo_spot)<>0 THEN
      valid_extension := TRUE
    ELSE
      valid_extension := FALSE ;
  END ;

{******************************************************************}
{*  This is the start of the main_loop procedure.                 *}
{******************************************************************}

  BEGIN
    erase_screen ;
    copyright_dialog ;
    valid_ext := FALSE ;
    file_to_input := TRUE ;
    file_name := '' ;

    WHILE (NOT valid_ext) AND file_to_input DO
      BEGIN
        file_to_input := Get_In_File( default_path, file_name ) ;
        valid_ext := valid_extension(file_name) ;
        IF (NOT valid_ext) AND file_to_input THEN
          BEGIN
            erase_screen ;
            alert_str := Concat('[3][.PI* and .NEO|',
                                    ' files only!][Cancel]') ;
            dummy := Do_Alert(alert_str,1) ;
          END ;
      END ;

    WHILE file_to_input DO
      BEGIN
        erase_screen ;
        IF neo_spot<>0 THEN
          result := Get_NEO
        ELSE
          result := Get_PI ;

        IF result=0 THEN
          BEGIN
            init_form(backup,screen_buffer,resolution);
            get_squares ;
            IF key<>$011B THEN
              BEGIN
                shuffle_picture ;
                exchange_squares ;
                IF puzzle_solved THEN
                  BEGIN
                    alert_str := Concat('[1][Congratulations!|You solved ',
                                        'The|Picture Puzzle!][ Hurray ]') ;
                    dummy := Do_Alert(alert_str,1) ;
                  END ;
              END ;
            erase_screen ;
          END
        ELSE
          IF result<>-99 THEN
            BEGIN
              alert_str := Concat('[3][Illegal picture|format!  Pick|',
                                  'another file!][Cancel]') ;
              dummy := Do_Alert(alert_str,1) ;
            END ;

        valid_ext := FALSE ;
        file_to_input := TRUE ;

        WHILE (NOT valid_ext) AND file_to_input DO
          BEGIN
            file_to_input := Get_In_File( default_path, file_name ) ;
            valid_ext := valid_extension(file_name) ;
            IF (NOT valid_ext) AND file_to_input THEN
              BEGIN
                erase_screen ;
                alert_str := Concat('[3][.PI* and .NEO|',
                                    ' files only!][Cancel]') ;
                dummy := Do_Alert(alert_str,1) ;
              END ;
          END ;
      END ;
  END ;

{******************************************************************}
{*  This procedure is called at the start of the program to init- *}
{*  ialize program variables.                                     *}
{******************************************************************}

PROCEDURE Initialize ;

VAR x: integer ;

{******************************************************************}
{*  This procedure sets the variables associated with the current *}
{*  resolution.                                                   *}
{******************************************************************}

PROCEDURE Set_Res_Vars(resolution: Integer) ;

BEGIN
  CASE resolution OF
    Low_Resolution:
      BEGIN
        Wmax := 320 ;
        Hmax := 200 ;
        palette_max := 15 ;
      END ;
    Medium_Resolution:
      BEGIN
        Wmax := 640 ;
        Hmax := 200 ;
        palette_max := 3 ;
      END ;
    High_Resolution:
      BEGIN
        Wmax := 640 ;
        Hmax := 400 ;
        palette_max := 1 ;
      END ;
  END ;
END ;

{******************************************************************}
{*  Start of procedure Initialize.                                *}
{******************************************************************}

  BEGIN
    init_mouse ;
    resolution := Get_Res ;
    set_res_vars(resolution) ;
    screen[addr1] := 0 ;
    screen[addr2] := 0 ;
    res_string[0] := 'Change to low' ;
    res_string[1] := 'Change to medium' ;
    res_string[2] := 'Change to high' ;
    chosen := 0 ;
    Line_Color(chosen) ;
    default_path := 'A:\*.PI*' ;
    FOR x := 0 TO 15 DO
      save_palette[x] := st_clr(x, -1) ;
  END ;

{******************************************************************}
{*  This is the program loop.  Gem is initialized, the program    *}
{*  variables are initialized, the main loop is called and then   *}
{*  the palette is returned to it's original state.               *}
{******************************************************************}

  BEGIN
    IF Init_Gem >= 0 THEN
      BEGIN
        Initialize ;
        Main_Loop ;
        Set_Palette(save_palette) ;
        Exit_Gem ;
      END ;
  END.